home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS12.ADF / AmigaBBS / boards (.txt) < prev    next >
AmigaBASIC Source Code  |  1986-08-05  |  12KB  |  337 lines
  1. Main:
  2. GOSUB Boards
  3. CHAIN "df0:Menus",20,ALL
  4.  
  5. Modem:
  6. IF rings=0 THEN OtherModem
  7. x=FRE(0)
  8. FOR j=1 TO LEN(a$):p$=MID$(a$,j,1)
  9. PRINT p$;:PRINT#1,p$;:NEXT j
  10. a$="":p$="":RETURN
  11.  
  12. OtherModem:
  13. x=FRE(0)
  14. FOR j=1 TO LEN(a$):p$=MID$(a$,j,1)
  15. PRINT p$;:NEXT j
  16. a$="":p$="":RETURN
  17.  
  18. Answers:
  19. telly=0:t$="":t=0:i$="":ch$="":alter=0:IF rings=0 THEN SomeAnswers
  20. WHILE 1 AND alter<1
  21.   WHILE LOC(1)<>0
  22.     ch$=INPUT$(1,1)
  23.     equivs=ASC(ch$) AND 127:IF equivs<>1 THEN ch$=CHR$(equivs)
  24.     i$=i$+ch$:equivs=0
  25.     telly=telly+1:IF telly=78 THEN ch$=r$:telly=0
  26.     IF ch$=CHR$(8) AND LEN(i$)>=2 THEN i$=LEFT$(i$,LEN(i$)-2):telly=telly-2
  27.     IF ch$=CHR$(10) OR ch$=CHR$(13) OR ch$=r$ THEN alter=3:telly=0
  28.     a$=ch$:GOSUB Modem:ch$="":connect=PEEK (&Hbfd*&H1000+&H0):IF connect<>0 THEN okp=0:RETURN
  29.   WEND
  30.   ch$=INKEY$:i$=i$+ch$
  31.   a$=ch$:GOSUB Modem
  32.   IF ch$=CHR$(10) OR ch$=CHR$(13) OR ch$=r$ THEN telly=0:GOTO MoreAnswers
  33.   IF ch$=CHR$(8) AND LEN(i$)>=2 THEN i$=LEFT$(i$,LEN(i$)-2)
  34.   ch$="":connect=PEEK (&Hbfd*&H1000+&H0):IF connect<>0 THEN okp=0:RETURN
  35. WEND
  36. IF i$<>"" THEN MoreAnswers
  37. SomeAnswers:
  38. ch$=INKEY$:i$=i$+ch$:a$=ch$:GOSUB Modem
  39. IF ch$= CHR$(10) OR ch$=CHR$(13) OR ch$=r$ THEN MoreAnswers
  40. IF ch$=CHR$(8) AND LEN(i$)>=2 THEN i$=LEFT$(i$,LEN(i$)-2)
  41. ch$=""
  42. GOTO SomeAnswers
  43. MoreAnswers:
  44. IF okp<>1 THEN RETURN
  45. IF i$="" THEN ch$="":GOTO Answers
  46. t$=i$:IF LEN(t$)>80 THEN t$=LEFT$(t$,78)+r$
  47. RETURN
  48.  
  49. SeqRead:
  50. ERASE TBL$:DIM TBL$(45)
  51. a$=r$+r$+"[>                                K Quits                               <]"+r$+r$:GOSUB Modem
  52. OPEN "I", #3, file$
  53. ReadSeq:
  54. j=0:L=0:k=0:Countl=0
  55. WHILE NOT EOF(3)
  56.   x=FRE(0):j=j+1
  57.   LINE INPUT#3,TBL$(j):TBL$(j)=TBL$(j)+r$
  58. WEND
  59. CLOSE#3:k=j:L=0:Detect=0
  60. WHILE L<k
  61.   L=L+1:a$=TBL$(L):GOSUB Modem
  62.   CheckSeq:
  63.   t$="":t=0:i$="":ch$="":IF rings=0 THEN SomeCheckSeq
  64.   WHILE LOC(1)<>0
  65.     ch$=INPUT$(1,1):equivs=ASC(ch$) AND 127:IF equivs<>1 THEN ch$=CHR$(equivs)
  66.     i$=i$+ch$:equivs=0:a$=ch$:GOSUB Modem
  67.   WEND
  68.   IF i$<>"" THEN MoreCheckSeq
  69.   SomeCheckSeq:
  70.   ch$=INKEY$:i$=i$+ch$:a$=ch$:GOSUB Modem
  71.   OtherCheckSeq:
  72.   IF Detect=1 GOTO MoreCheckSeq
  73.   Countl=Countl+1:IF Countl=24 THEN a$=r$+"More (y,n,c)?":GOSUB A1
  74.   IF Countl=24 THEN MenS$=UCASE$(LEFT$(t$,1)):IF MenS$="N" THEN L=k+1
  75.   IF Countl=24 AND MenS$="Y" THEN Countl=0
  76.   IF Countl=24 AND MenS$="C" THEN Detect=1
  77.   IF Countl=24 AND Detect<>1 THEN Countl=0
  78.   MoreCheckSeq:
  79.   IF i$=CHR$(75) OR i$=CHR$(107) THEN L=k+1
  80. WEND
  81. ERASE TBL$:DIM TBL$(45):RETURN
  82.  
  83. A1:
  84. GOSUB Modem:GOSUB Answers:RETURN
  85.  
  86. Boards:
  87. IF okp<>1 THEN RETURN
  88. GOSUB CheckConTime:IF okp<>1 THEN RETURN
  89. MenS$="":L=0
  90. a$=r$+"Loading Titles..."+r$:GOSUB Modem
  91. OPEN "I", #3, "df1:Board/B"+RIGHT$(zl$,1)
  92. FOR j=1 TO 4:LINE INPUT#3,numM$(j):NEXT j:CLOSE#3
  93. OPEN "I", #3, "df1:Board/"+zl$
  94. FOR j=1 TO VAL(numM$(3))*2
  95. L=L+1
  96. LINE INPUT#3,ABCS$(j):ABCS$(j)=ABCS$(j)+r$
  97. IF L=2 THEN ABCS$(j)=ABCS$(j)+r$:L=0
  98. NEXT j:CLOSE#3
  99. a$=r$+"There are "+numM$(3)+" messages."+r$:GOSUB Modem
  100. a$=r$+"Highest message you have read is "+Board$(meni)+r$:GOSUB Modem
  101. MoreBoards:
  102. IF okp<>1 THEN RETURN
  103. GOSUB CheckConTime:IF okp<>1 THEN RETURN
  104. MenS$="":a$=r$+"B"+RIGHT$(zl$,1)+":":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  105. IF MenS$="H" THEN file$="df1:Board/BHelp":GOSUB SeqRead:GOTO MoreBoards
  106. IF MenS$="?" THEN file$="df1:Board/BMenu":GOSUB SeqRead:GOTO MoreBoards
  107. IF MenS$="R" THEN BoardRead
  108. IF MenS$="L" THEN file$="df1:Board/ListBoards":GOSUB SeqRead:GOTO MoreBoards
  109. IF MenS$="P" THEN GOSUB BoardPost:GOTO MoreBoards
  110. IF MenS$="S" THEN BoardScan
  111. IF MenS$="C" THEN BoardChange
  112. IF MenS$="X" THEN RETURN
  113. a$=r$+"No such command."+r$:GOSUB Modem:GOTO MoreBoards
  114.  
  115. CheckConTime:
  116. ContiMe$=TIME$:ChEntTime$=RIGHT$(EnttiMe$,5):ContiMe$=RIGHT$(ContiMe$,5)
  117. ContiMe=VAL(ContiMe$):EnttiMe=VAL(ChEntTime$)
  118. IF EnttiMe>58 AND EnttiMe>ContiMe THEN EnttiMe=ContiMe
  119. IF ContiMe-EnttiMe>30 AND Veru$="000" THEN okp=0:a$=r$+"Time limit exceeded."+r$:GOSUB Modem:RETURN
  120. IF ContiMe-EnttiMe>45 AND Veru$="007" THEN okp=0:a$=r$+"Time limit exceeded."+r$:GOSUB Modem:RETURN
  121. okp=1:RETURN
  122.  
  123. BoardPost:
  124. IF Veru$="000" THEN a$=r$+"Not validated for that command":GOSUB Modem:RETURN
  125. a$=r$+"Subject:":GOSUB A1:Subject$=LEFT$(t$,LEN(t$)-1):IF LEN(Subject$)>30 THEN BoardPost
  126. TBL$(1)="Time:"+TIME$+" "+"Date:"+DATE$
  127. TBL$(2)="Name:"+Name1$+" "+Name2$+"Subject:"+Subject$+" UserID:"+UserID$
  128. TBL$(3)=r$
  129. a$=r$+"Enter Message: [Max. 40 lines]  /EX to Exit"+r$:GOSUB Modem
  130. Extm=0:Ddt=3
  131. WHILE Extm<1
  132.   Ddt=Ddt+1
  133.   a$=r$+STR$(Ddt-3)+":":GOSUB A1
  134.   TBL$(Ddt)=t$
  135.   IF UCASE$(LEFT$(t$,3))="/EX" THEN Extm=1:Ddt=Ddt-1
  136.   IF Ddt=42 THEN a$=r$+"Last Line!":GOSUB Modem
  137.   IF Ddt=43 THEN Extm=1
  138. WEND
  139. QueryBoardPost:
  140. a$=r$+"A- Abort  S- Save  L- List  I- Insert  R- Replace  C- Continue  D- Delete :":GOSUB A1
  141. MenS$=UCASE$(LEFT$(t$,1))
  142. IF MenS$="A" THEN RETURN
  143. IF MenS$="S" THEN GOSUB BoardPostSave:RETURN
  144. IF MenS$="L" THEN BoardPostList
  145. IF MenS$="I" THEN BoardPostInsert
  146. IF MenS$="R" THEN BoardPostReplace
  147. IF MenS$="D" THEN BoardPostDelete
  148. IF MenS$="C" THEN BoardPostContinue
  149. GOTO QueryBoardPost
  150.  
  151. BoardPostInsert:
  152. IF Ddt>=199 THEN a$=r$+"No room to insert.":GOSUB Modem:GOTO QueryBoardPost
  153. a$=r$+"Insert before which line:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN QueryBoardPost
  154. instln=VAL(t$)+3
  155. FOR j=Ddt TO instln STEP -1
  156. TBL$(j+1)=TBL$(j)
  157. NEXT j
  158. TBL$(instln)="    "+r$:Ddt=Ddt+1
  159. GOTO QueryBoardPost
  160.  
  161. BoardPostDelete:
  162. a$=r$+"Delete starting which line:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN QueryBoardPost
  163. stln=VAL(t$)+3:IF stln<4 OR stln>Ddt THEN QueryBoardPost
  164. a$=r$+"Ending which line:":GOSUB A1:endtln=VAL(t$)+3:IF endtln>Ddt THEN endtln=Ddt
  165. IF stln>endtln THEN SWAP stln,endtln
  166. a$=r$+"Delete from"+STR$(stln-3)+" to"+STR$(endtln-3)+r$+"Are you sure? (Y or N):":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  167. IF MenS$="N" THEN QueryBoardPost
  168. FOR j=endtln+1 TO Ddt
  169. TBL$(j-((endtln+1)-stln))=TBL$(j)
  170. NEXT j
  171. Ddt=Ddt-((endtln+1)-stln)
  172. FOR j=Ddt TO Ddt+((endtln+1)-stln)
  173. TBL$(j)="    "+r$
  174. NEXT j
  175. GOTO QueryBoardPost
  176.  
  177. BoardPostList:
  178. a$=r$+"Line to start at:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN QueryBoardPost
  179. stln=VAL(t$)+3:IF stln<4 OR stln>Ddt THEN QueryBoardPost
  180. a$=r$+"Line to stop at:":GOSUB A1:endtln=VAL(t$)+3:IF endtln<stln THEN QueryBoardPost
  181. IF endtln>Ddt THEN endtln=Ddt
  182. FOR L=stln TO endtln
  183. a$=STR$(L-3)+":"+TBL$(L):GOSUB Modem
  184. NEXT L
  185. GOTO QueryBoardPost
  186.  
  187. BoardPostReplace:
  188. a$=r$+"Replace which line:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN QueryBoardPost
  189. rplnn=VAL(t$)+3:IF rplnn<4 OR rplnn>Ddt THEN QueryBoardPost
  190. a$=r$+"Replace:"+ABCS$(rplnn)+"With:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN QueryBoardPost
  191. Temprep$=t$
  192. a$=r$+"Replace:"+TBL$(rplnn)+"With:"+Temprep$+"(Y or N):":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  193. IF MenS$="Y" THEN TBL$(rplnn)=Temprep$
  194. GOTO QueryBoardPost
  195.  
  196. BoardPostContinue:
  197. IF Ddt>198 THEN a$=r$+"No Room!":GOTO QueryBoardPost
  198. Dzz=0
  199. a$=r$+"Enter Text: [Max. 197 lines] /EX to Exit":GOSUB Modem
  200. WHILE Dzz<1
  201.   Ddt=Ddt+1
  202.   a$=r$+STR$(Ddt-3)+":":GOSUB A1:TBL$(Ddt)=t$
  203.   IF UCASE$(LEFT$(t$,3))="/EX" THEN Dzz=1:Ddt=Ddt-1
  204.   IF Ddt=199 THEN a$=r$+"Last Line!":GOSUB Modem
  205.   IF Ddt=200 THEN Dzz=1
  206. WEND
  207. GOTO QueryBoardPost
  208.  
  209. BoardPostSave:
  210. Guanm(1)=VAL(numM$(1)):Guanm(2)=VAL(numM$(2)):Guanm(3)=VAL(numM$(3)):Guanm(4)=VAL(numM$(4))
  211. CLOSE#3
  212. OPEN "A",#3,"df1:Board/"+zl$
  213. PRINT#3,TBL$(1)
  214. PRINT#3,TBL$(2)
  215. CLOSE#3:ABCS$((Guanm(4)*2)-1)=TBL$(1)+r$:ABCS$(Guanm(4)*2)=TBL$(2)+r$+r$
  216. Guanm(2)=Guanm(4):Guanm(3)=Guanm(3)+1
  217. Guanm(4)=Guanm(4)+1
  218. numM$(1)=STR$(Guanm(1)):numM$(1)=RIGHT$(numM$(1),LEN(numM$(1))-1)
  219. numM$(2)=STR$(Guanm(2)):numM$(2)=RIGHT$(numM$(2),LEN(numM$(2))-1)
  220. numM$(3)=STR$(Guanm(3)):numM$(3)=RIGHT$(numM$(3),LEN(numM$(3))-1)
  221. numM$(4)=STR$(Guanm(4)):numM$(4)=RIGHT$(numM$(4),LEN(numM$(4))-1)
  222. Board$(meni)=numM$(2)
  223. OPEN "O",#3,"df1:Board/B"+RIGHT$(zl$,1)
  224. FOR j=1 TO 4
  225. PRINT#3,numM$(j)
  226. NEXT j:CLOSE#3
  227. Boars$=STR$(Guanm(2)):Boars$=RIGHT$(Boars$,LEN(Boars$)-1)
  228. Boars$=RIGHT$(zl$,1)+Boars$+"."
  229. OPEN "O",#3,"df1:Board/"+Boars$
  230. FOR j=1 TO Ddt
  231. PRINT#3,TBL$(j)
  232. NEXT j:CLOSE#3
  233. RETURN
  234.  
  235. BoardRead:
  236. a$=r$+"N- New  F- Forward  R- Reverse  M- Marked  X- Exit :":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  237. IF MenS$="N" THEN NewBoardRead
  238. IF MenS$="F" THEN ForwardBoardRead
  239. IF MenS$="R" THEN ReverseBoardRead
  240. IF MenS$="M" THEN MarkedBoardRead
  241. IF MenS$="X" THEN MoreBoards
  242. GOTO BoardRead
  243.  
  244. NewBoardRead:
  245. chde=0:bbk=VAL(Board$(meni)):IF bbk=VAL(numM$(2)) THEN a$=r$+"No new messages.":GOSUB Modem:GOTO BoardRead
  246. WHILE chde<1
  247.   bbk=bbk+1
  248.   Board$(meni)=STR$(bbk):Board$(meni)=RIGHT$(Board$(meni),LEN(Board$(meni))-1)
  249.   Boars$=RIGHT$(zl$,1)+Board$(meni)+"."
  250.   file$="df1:Board/"+Boars$:Ddt=0:GOSUB SeqRead
  251.   a$=r$+"N- Next  R- Reply  Q- Quit :":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  252.   IF MenS$="R" THEN GOSUB BoardPost
  253.   IF MenS$="Q" THEN bbk=VAL(numM$(2))
  254.   IF bbk=VAL(numM$(2)) THEN chde=1
  255. WEND
  256. GOTO BoardRead
  257.  
  258. ForwardBoardRead:
  259. a$=r$+"Messages "+numM$(1)+" to "+numM$(2):GOSUB Modem
  260. a$=r$+"Start with which message :":GOSUB A1:bbk=VAL(t$)
  261. IF bbk<VAL(numM$(1)) OR bbk> VAL(numM$(2)) THEN BoardRead
  262. chde=0
  263. WHILE chde<1
  264.   IF bbk> VAL(Board$(meni)) THEN Board$(meni)=STR$(bbk):Board$(meni)=RIGHT$(Board$(meni),LEN(Board$(meni))-1)
  265.   Boars$=STR$(bbk):Boars$=RIGHT$(Boars$,LEN(Boars$)-1)
  266.   Boars$=RIGHT$(zl$,1)+Boars$+"."
  267.   file$="df1:Board/"+Boars$:Ddt=0:GOSUB SeqRead
  268.   a$=r$+"N- Next  R- Reply  Q- Quit :":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  269.   IF MenS$="R" THEN GOSUB BoardPost
  270.   IF MenS$="Q" THEN bbk=VAL(numM$(2))+1
  271.   bbk=bbk+1
  272.   IF bbk>VAL(numM$(2)) THEN chde=1
  273. WEND
  274. GOTO BoardRead
  275.  
  276. ReverseBoardRead:
  277. a$=r$+"Messages "+numM$(1)+" to "+numM$(2):GOSUB Modem
  278. a$=r$+"Start with which message :":GOSUB A1:bbk=VAL(t$)
  279. IF bbk<VAL(numM$(1)) THEN BoardRead
  280. IF bbk>VAL(numM$(2)) THEN bbk=VAL(numM$(2))
  281. chde=0
  282. WHILE chde<1
  283.   IF bbk> VAL(Board$(meni)) THEN Board$(meni)=STR$(bbk):Board$(meni)=RIGHT$(Board$(meni),LEN(Board$(meni))-1)
  284.   Boars$=STR$(bbk):Boars$=RIGHT$(Boars$,LEN(Boars$)-1)
  285.   Boars$=RIGHT$(zl$,1)+Boars$+"."
  286.   file$="df1:Board/"+Boars$:Ddt=0:GOSUB SeqRead
  287.   a$=r$+"N- Next  R- Reply  Q- Quit :":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  288.   IF MenS$="R" THEN GOSUB BoardPost
  289.   IF MenS$="Q" THEN bbk=VAL(numM$(1))
  290.   bbk=bbk-1
  291.   IF bbk<VAL(numM$(1)) THEN chde=1
  292. WEND
  293. GOTO BoardRead
  294.  
  295. MarkedBoardRead:
  296. IF lamprey=0 THEN a$=r$+"No messages marked.":GOSUB Modem:GOTO BoardRead
  297. chde=0:bbk=0:CLOSE#3
  298. WHILE chde<1
  299.   bbk=bbk+1:Ddt=0
  300.   leersr=VAL(ScanM$(bbk))
  301.   IF leersr> VAL(Board$(meni)) THEN Board$(meni)=STR$(bbk):Board$(meni)=RIGHT$(Board$(meni),LEN(Board$(meni))-1)
  302.   file$="df1:Board/"+RIGHT$(zl$,1)+ScanM$(bbk)+".":GOSUB SeqRead
  303.   a$="N- Next  R- Reply  Q- Quit :":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  304.   IF MenS$="R" THEN GOSUB BoardPost
  305.   IF MenS$="Q" THEN bbk=lamprey
  306.   IF bbk=lamprey THEN chde=1
  307. WEND
  308. GOTO BoardRead
  309.   
  310. BoardScan:
  311. a$=r$+"Messages "+numM$(1)+" to "+numM$(2):GOSUB Modem
  312. a$=r$+"Start which Message :":GOSUB A1:k=VAL(t$)
  313. IF k<VAL(numM$(1)) OR k>VAL(numM$(2)) THEN MoreBoards
  314. a$=r$+"Mark Messages? (Y or N):":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  315. IF MenS$="Y" THEN elwin=1:GOTO MoreScan
  316. elwin=0
  317. MoreScan:
  318. edch=0:lamprey=0
  319. WHILE edch<1
  320.   a$=ABCS$((k*2)-1):GOSUB Modem
  321.   a$=ABCS$(k*2):GOSUB Modem
  322.   IF elwin=1 THEN a$=r$+"Mark (Y or N):":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  323.   IF elwin=1 AND MenS$="Y" THEN lamprey=lamprey+1:ScanM$(lamprey)=STR$(k)
  324.   IF elwin=1 AND MenS$="Y" THEN ScanM$(lamprey)=RIGHT$(ScanM$(lamprey),LEN(ScanM$(lamprey))-1)
  325.   k=k+1
  326.   IF k>VAL(numM$(2)) THEN edch=1
  327. WEND
  328. GOTO MoreBoards
  329.  
  330. BoardChange:
  331. a$=r$+"Choose Board (1-9) or List (L) :":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1)):meni=VAL(t$)
  332. IF MenS$=CHR$(10)OR MenS$=CHR$(13) THEN MoreBoards
  333. IF MenS$="L" THEN file$="df1:Board/ListBoards":GOSUB SeqRead:GOTO BoardChange
  334. IF meni>=1 AND meni<=9 THEN zl$="FmT"+MenS$:GOTO Boards
  335. GOTO BoardChange
  336.  
  337.